***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
*** This Program already converted to Y2K                                                                                                                                                                                                                 
*** S&T Departement     on 29 April 1999 by Ben.Rahman                                                                                                                                                                                                    
***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
set cent on                                                                                                                                                                                                                                               
*  FILE NAME: PMOD5.PRG                                                                                                                                                                                                                                   
*  BY: NURJADI PURNAMA                                                                                                                                                                                                                                    
*  DATE: June 20, 1996                                                                                                                                                                                                                                    
*  DESC:                                                                                                                                                                                                                                                  
*  CALLED BY:  PMOD0.PRG                                                                                                                                                                                                                                  
*  DATA FILES:                                                                                                                                                                                                                                            
*                                                                                                                                                                                                                                                         
*  Comments by Dickson 04/01/99                                                                                                                                                                                                                           
**                                                                                                                                                                                                                                                        
** Amended by Dickson - 04/01/99                                                                                                                                                                                                                          
** Split the system date to CCYY, MM & DD                                                                                                                                                                                                                 
  Set date to British                                                                                                                                                                                                                                     
  Today_DD = VAl(SUBSTR(DTOC(DATE()),1,2))                                                                                                                                                                                                                
  Today_MM = VAL(SUBSTR(DTOC(DATE()),4,2))                                                                                                                                                                                                                
  Today_YY = VAL(SUBSTR(DTOC(DATE()),7,4))                                                                                                                                                                                                                
  IF Today_YY < 10                                                                                                                                                                                                                                        
     Today_CCYY = 2000 + Today_YY                                                                                                                                                                                                                         
  ELSE                                                                                                                                                                                                                                                    
     Today_CCYY = 1900 + Today_YY                                                                                                                                                                                                                         
  ENDIF                                                                                                                                                                                                                                                   
**                                                                                                                                                                                                                                                        
**                                                                                                                                                                                                                                                        
                                                                                                                                                                                                                                                          
** Amended by Dickson - 11/2/99 - to display the previous AEA validity date                                                                                                                                                                               
  uAEA_ENDATE = AEA_ENDATE
  uPAT_REFER = PAT_REFER
**                                                                                                                                                                                                                                                        
                                                                                                                                                                                                                                                          
LAY=SAVESCREEN(0,0,24,79)                                                                                                                                                                                                                                 
memval=ctod("  /  /      ")                                                                                                                                                                                                                               
comcod='0000'                                                                                                                                                                                                                                             
CODDAT='0000'                                                                                                                                                                                                                                             
P22=0                                                                                                                                                                                                                                                     
SET COLOR TO BG+/B                                                                                                                                                                                                                                        
@ 10,1 CLEA TO 23,78                                                                                                                                                                                                                                      
DO BOXT WITH 10,1,"NAME : "+ALLTRIM(PAT_F_NAME)+' '+ALLTRIM(PAT_NAME)+",    CODE : "+PAT_FILCOD+' '+PAT_CODCRP+' '+PAT_CODCRE+' '+PAT_CODDAT+' '+PAT_CODTYP,'BG+','B',.F.,.F.                                                                             

** 12/5/2000 - start - Dickson
  do boxT with 13,3,"EXISTING AEA MEMBER TYPE: "+AEA_PROGR,'GR+','RB',.F.,.T.

**DO BOX2 WITH 16,3,"AEA MEMBERSHIP :",'YES','NO','gr+','r','gR+','B',P22,.f.,.T.
*IF P22=1                                                                                                                                                                                                                                                  
   SELE 6                                                                                                                                                                                                                                                 
   F7='PROGRAM'                                                                                                                                                                                                                                           
   SELE 6                                                                                                                                                                                                                                                 
   SET EXCLU OFF                                                                                                                                                                                                                                          
   USE &DR&F7                                                                                                                                                                                                                                             
   COUNT TO CNT                                                                                                                                                                                                                                           
   IF CNT=0                                                                                                                                                                                                                                               
      RESTSCREEN(0,0,24,79,LAY)                                                                                                                                                                                                                           
      SELE 1                                                                                                                                                                                                                                              
      RETURN                                                                                                                                                                                                                                              
   ENDIF                                                                                                                                                                                                                                                  
   DECLARE FILD[CNT]                                                                                                                                                                                                                                      
   DECLARE MCOD[CNT]                                                                                                                                                                                                                                      
   DECLARE DARI[CNT]                                                                                                                                                                                                                                      
   DECLARE HING[CNT]                                                                                                                                                                                                                                      
   DECLARE MNAM[CNT]                                                                                                                                                                                                                                      
   SELE 6                                                                                                                                                                                                                                                 
   GO TOP                                                                                                                                                                                                                                                 
   CR=0                                                                                                                                                                                                                                                   
   DO WHILE .NOT. EOF()                                                                                                                                                                                                                                   
      CR=CR+1                                                                                                                                                                                                                                             
** Dickson - Start (18-June-2001) - Sort by Pgm Name instead of Pgm code
**      FILD[CR]=PROGRAM_CD+' '+PROGRAM_NM
      FILD[CR]=PROGRAM_NM+'   '+PROGRAM_CD
** Dickson - End

      MNAM[CR]=PROGRAM_NM                                                                                                                                                                                                                                 
      MCOD[CR]=PROGRAM_CD                                                                                                                                                                                                                                 
*      DARI[CR]=PROGRAM_FR                                                                                                                                                                                                                                
*      HING[CR]=PROGRAM_TO                                                                                                                                                                                                                                
      DARI[CR]=MEMB_START                                                                                                                                                                                                                                 
      HING[CR]=MEMB_END                                                                                                                                                                                                                                   
      SKIP                                                                                                                                                                                                                                                
   ENDDO                                                                                                                                                                                                                                                  
   set colo to w/b                                                                                                                                                                                                                                        
   inkey()                                                                                                                                                                                                                                                

 store .F. to done
 do while done = .F.
   set colo to w+/rb,gr+/r
   @ 16,43 clea to 23,75                                                                                                                                                                                                                                  
   @ 16,43 to 23,75 double                                                                                                                                                                                                                                
   pilih=achoice(17,45,22,73,FILD)                                                                                                                                                                                                                        
   IF LASTKEY()=13                                                                                                                                                                                                                                        
      AEAM=.T.                                                                                                                                                                                                                                            
*      restscreen(0,0,24,79,lay)                                                                                                                                                                                                                          
      DARF=FILD[PILIH]                                                                                                                                                                                                                                    
      CMEM=MCOD[PILIH]                                                                                                                                                                                                                                    
      NMEM=MNAM[PILIH]                                                                                                                                                                                                                                    
      MDR=DARI[PILIH]                                                                                                                                                                                                                                     
      MHG=HING[PILIH]                                                                                                                                                                                                                                     
      SET COLO TO BG+/B,W+/N                                                                                                                                                                                                                              
      @ 15,2 CLEAR TO 23,78                                                                                                                                                                                                                               
      do boxT with 17,3,"NEW MEMBER TYPE : "+ALLTRIM(NMEM),'GR+','RB',.F.,.T.                                                                                                                                                                                                  

** ------------ new field added for Dr. Soraya - Network Statistic ----
** Dickson - Start (18-June-2001) - Added for Tanya - If member type = 'INSURANCE' then prompts for Insu. Comp name
**      IF ALLTRIM(NMEM) = "TOURIST" .OR. ALLTRIM(NMEM) = "TEMP RESIDENT" .OR. ALLTRIM(NMEM) = "OTHER INSURANCE"
** Buu - 19/7/04 : Add in field "REfer" for Immgration CUP
      IF ALLTRIM(NMEM) = "TOURIST" .OR. ALLTRIM(NMEM) = "TOURIST-OTAI" .OR. ALLTRIM(NMEM) = "TEMP RESIDENT" .OR. ALLTRIM(NMEM) = "TEMP RESID-OTAI" .OR. ALLTRIM(NMEM) = "IMMIGRATION CUP" .OR. ALLTRIM(NMEM) = "OTHER INSURANCE" 

         set colo to w/b
         @ 16,43 clea to 23,75
         If ALLTRIM(NMEM) = "OTHER INSURANCE"
            DO BOXT   WITH 20,2,"Insurance company :"+UPAT_REFER,'BG+','B',.F.,.F. 
**            DO BOXENNOE WITH 20,2,"Insurance company :",'uPAT_REFER','BG+','B','W+','N',30,.F.,.F.
                  STORE SPACE(35) TO INSNAM 
                  DO JAPINS
                  uPAT_REFER = ALLTRIM(INSNAM)
         ELSE
            DO BOXT   WITH 20,2,"Refer by/Know from:"+UPAT_REFER,'BG+','B',.F.,.F. 
            DO BOXENNOE WITH 20,2,"Refer by/know from:",'uPAT_REFER','BG+','B','W+','N',30,.F.,.F.
         ENDIF
      ENDIF
** --------------

*   else
*      AEAM=.F.                                                                                                                                                                                                                                            
*      SET COLO TO BG+/B,W+/N                                                                                                                                                                                                                              
*      RESTSCREEN(0,0,24,79,LAY)                                                                                                                                                                                                                           
*      SELE 1                                                                                                                                                                                                                                              
*      RETURN                                                                                                                                                                                                                                              
      DONE = .T.
   ENDIF

 ENDDO

*ELSE
*   IF LASTKEY()=27                                                                                                                                                                                                                                        
*      AEAM=.F.                                                                                                                                                                                                                                            
*      SET COLO TO BG+/B,W+/N                                                                                                                                                                                                                              
*      RESTSCREEN(0,0,24,79,LAY)                                                                                                                                                                                                                           
*      SELE 1                                                                                                                                                                                                                                              
*      RETURN                                                                                                                                                                                                                                              
*   ELSE                                                                                                                                                                                                                                                   
*      AEAM=.F.                                                                                                                                                                                                                                            
*      NMEM=SPACE(30)                                                                                                                                                                                                                                      
*      CMEM=SPACE(3)                                                                                                                                                                                                                                       
*   ENDIF                                                                                                                                                                                                                                                  
*ENDIF                                                                                                                                                                                                                                                     
IF CMEM='CP'                                                                                                                                                                                                                                              
   CP=.T.                                                                                                                                                                                                                                                 
ELSE                                                                                                                                                                                                                                                      
   CP=.F.                                                                                                                                                                                                                                                 
ENDIF                                                                                                                                                                                                                                                     

** 12/05/2000 - Start - Dickson
**  remove the Membership Date entries field so that the Cashier can Select
**  the appropriate member type without having to know the expiry date
**  as requested by Philippe GL
**
**do while memval=ctod("  /  /      ") .and. aeam
**   set colo to bg+/b,w+/n                                                                                                                                                                                                                                 

**   @ 19,23 SAY 'Previous Validity Date   : '                                                                                                                                                                                                              
**   @ 19,51 SAY DTOC(uAEA_ENDATE) pict '99/99/9999'                                                                                                                                                                                                        
**   @ 20,23 say 'Membership Validity Date : ' get memval pict '99/99/9999'                                                                                                                                                                                 
**   read                                                                                                                                                                                                                                                   
**   lyr=savescreen(0,0,24,79)                                                                                                                                                                                                                              
                                                                                                                                                                                                                                                          
** Amended by Dickson - to handle the Expiry date beyond year 2000                                                                                                                                                                                        
**                                                                                                                                                                                                                                                        
**            memval_DD = VAL(SUBSTR(dtoc(memval),1,2))                                                                                                                                                                                                     
**            memval_MM = VAL(SUBSTR(dtoc(memval),4,2))                                                                                                                                                                                                     
**            memval_YY = VAL(SUBSTR(dtoc(memval),7,4))                                                                                                                                                                                                     
**            IF memval_YY < 10                                                                                                                                                                                                                             
**               memval_CCYY = 2000 + memval_YY                                                                                                                                                                                                             
**            ELSE                                                                                                                                                                                                                                          
**               memval_CCYY = 1900 + memval_YY                                                                                                                                                                                                             
**            ENDIF                                                                                                                                                                                                                                         
                                                                                                                                                                                                                                                          
**            AEAM_EXPIRED = .T.                                                                                                                                                                                                                            
**            IF memval_CCYY < TODAY_CCYY                                                                                                                                                                                                                   
**               AEAM_EXPIRED = .T.                                                                                                                                                                                                                         
**            ELSEIF memval_CCYY > TODAY_CCYY                                                                                                                                                                                                               
**               AEAM_EXPIRED = .F.                                                                                                                                                                                                                         
**                                                                                                                                                                                                                                                          
**                      ** same year                                                                                                                                                                                                                        
**            ELSE                                                                                                                                                                                                                                          
**                                                                                                                                                                                                                                                          
**               IF memval_MM < TODAY_MM                                                                                                                                                                                                                    
**                  AEAM_EXPIRED = .T.                                                                                                                                                                                                                      
**               ELSEIF  memval_MM > TODAY_MM                                                                                                                                                                                                               
**                  AEAM_EXPIRED = .F.                                                                                                                                                                                                                      
**                                                                                                                                                                                                                                                          
**                      ** same month                                                                                                                                                                                                                       
**               ELSE                                                                                                                                                                                                                                       
**                  IF  memval_DD < TODAY_DD                                                                                                                                                                                                                
**                      AEAM_EXPIRED = .T.                                                                                                                                                                                                                  
**                  ELSE                                                                                                                                                                                                                                    
**                      AEAM_EXPIRED = .F.                                                                                                                                                                                                                  
**                  ENDIF                                                                                                                                                                                                                                   
**               ENDIF                                                                                                                                                                                                                                      
**            ENDIF                                                                                                                                                                                                                                         
**                                                                                                                                                                                                                                                          
**            IF  AEAM_EXPIRED = .T.                                                                                                                                                                                                                        
**                                                                                                                                                                                                                                                        
**   IF memVAL<DATE()                                                                                                                                                                                                                                     
                                                                                                                                                                                                                                                          
**  End Amendment by Dickson                                                                                                                                                                                                                              
**                                                                                                                                                                                                                                                        
                                                                                                                                                                                                                                                          
**      do boxT with 21,25,"Membership Card Has Already Expired",'gr+','r',.F.,.t.                                                                                                                                                                          
**      set cursor off                                                                                                                                                                                                                                      
**      wait''                                                                                                                                                                                                                                              
**      @ 21,25 SAY repl(' ',50)                                                                                                                                                                                                                            
**      set cursor on                                                                                                                                                                                                                                       
**      memval=ctod("  /  /      ")                                                                                                                                                                                                                         
**      set colo to bg+/b,w+/n                                                                                                                                                                                                                              
**      restscreen(0,0,24,79,lyr)                                                                                                                                                                                                                           
**      loop                                                                                                                                                                                                                                                
**   endif                                                                                                                                                                                                                                                  
**   CODDAT=SUBSTR(DTOC(memval),1,2)+SUBSTR(DTOC(memval),4,2)                                                                                                                                                                                               
**enddo
** 12/05/2000 - end

SELE 1                                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
IF REC_LOCK()                                                                                                                                                                                                                                             
   REPL AEA_MEMBER WITH AEAM                                                                                                                                                                                                                              
   REPL AEA_PROGR WITH NMEM                                                                                                                                                                                                                               
   REPL HEALTHLINE WITH CP                                                                                                                                                                                                                                
   IF CMEM='CP'                                                                                                                                                                                                                                           
      REPL HL_END WITH MEMVAL                                                                                                                                                                                                                             
   ENDIF                                                                                                                                                                                                                                                  
   REPL AEA_ENDATE WITH MEMVAL                                                                                                                                                                                                                            
   REPL PAT_CODDAT WITH CODDAT                                                                                                                                                                                                                            

** Dickson - Start 30/7/2000 - add in the new field 'Refer By'  - requested by Dr. Soraya
   REPL PAT_REFER WITH UPAT_REFER
** Dickson - End 30/7/2000 - add in the new field 'Refer By'  - requested by Dr. Soraya
**                                                                                                                                                                                                                                                        
** Amendment - 8/2/99 - Dickson - For the E-Care system                                                                                                                                                                                                   
   IF AEAM .and. CMEM ='03'                                                                                                                                                                                                                               
      REPL PAT_CODTYP WITH '3'                                                                                                                                                                                                                            
   ELSE                                                                                                                                                                                                                                                   
**                                                                                                                                                                                                                                                        
**    Reset the Patient Code Type back to Normal if previously is E-Care                                                                                                                                                                                  
      IF PAT_CODTYP = '3'                                                                                                                                                                                                                                 
         REPL PAT_CODTYP WITH '6'                                                                                                                                                                                                                         
      ENDIF                                                                                                                                                                                                                                               
   ENDIF                                                                                                                                                                                                                                                  
                                                                                                                                                                                                                                                          
** End amendment - Dickson                                                                                                                                                                                                                                
ENDIF                                                                                                                                                                                                                                                     
UNLOCK                                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
RETURN                                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
*Formatted by: Herman T Ver. 7.1  on June 20, 1996.                                                                                                                                                                                                       
